home *** CD-ROM | disk | FTP | other *** search
/ EnigmA Amiga Run 1998 July / EnigmA AMIGA RUN 29 (1998)(G.R. Edizioni)(IT)[!][issue 1998-07 & 08].iso / earkit / news / thor / rexx / headermanager.thor < prev    next >
Text File  |  1998-05-24  |  12KB  |  383 lines
  1. /*
  2. $VER: HeaderManager.thor 1.15 (5.1.97)
  3. (c)  Neil Bothwick <neil@wirenet.co.uk> 1997
  4. */
  5.  
  6. /* Adds, edits and deletes header lines in Thor events  */
  7.  
  8. /* Thanks to ForwardMsg.thor by Petter Nilsen for some  */
  9. /* of the user database code                            */
  10.  
  11. options results
  12.  
  13. /* ;;;needs THOR and bbsread.library functions */
  14. thorport = address()
  15. if left(thorport,5) ~= 'THOR.' then do
  16.     say 'Headers.thor must be run from within Thor.'
  17.     end
  18.  
  19. if ~show('p', 'BBSREAD') then do
  20.     address command
  21.     'run >nil: `GetEnv THOR/THORPath`bin/LoadBBSRead'
  22.     'WaitForPort BBSREAD'
  23.     end
  24. ;;;
  25. /* ;;;Set up some stuff */
  26. Changed = 0
  27. drop Menu. HdrMenu.
  28. Menu.1 = '""'
  29. Menu.2 = '"Add new header"'
  30. Menu.3 = '""'
  31. Menu.4 = '"Save and exit"'
  32. Menu.5 = '""'
  33. Menu.6 = '"HELP"'
  34. Menu.Count = 6
  35. HdrMenu.1 = 'Cc:'
  36. HdrMenu.2 = 'Bcc:'
  37. HdrMenu.3 = 'Followup-To:'
  38. HdrMenu.4 = 'Reply-To:'
  39. HdrMenu.5 = 'Custom'
  40. HdrMenu.Count = 5
  41. ThorPath = pragma('D')
  42. ;;;
  43. /* ;;;Read system details */
  44. address(thorport)
  45. drop GLOBALCFG. CURRENT. BBS.
  46. GETGLOBALCONFIG stem GLOBALCFG
  47. CURRENTSYSTEM stem CURRENT
  48. System = CURRENT.BBSNAME
  49.  
  50. address(bbsread)
  51. GETBBSDATA bbsname '"'System'"' stem BBS
  52. MailAddr = BBS.EMAILADDR
  53. DataPath = BBS.BBSPATH
  54. ;;;
  55. /* ;;;Get number of selected event */
  56. address(thorport)
  57. GETSELECTEDEVENT
  58. if(rc ~= 0) then do
  59.     address(thorport)
  60.     errstring = THOR.LASTERROR
  61.     if RC = 5 then errstring = 'Event window not open'
  62.     call ExitMsg(errstring)
  63.     end
  64. EventNo = result
  65. ;;;
  66. /* ;;;Get event details */
  67. address(bbsread)
  68. READBREVENT '"'System'"' eventnr EventNo datastem EVENTDATA tagsstem EVENTTAGS
  69. if RC > 0 then call ExitMsg(BBSREAD.LASTERROR)
  70. if (EVENTDATA.EVENTTYPE > 1) & (EVENTDATA.EVENTTYPE ~= 9) then call ExitMsg('You can only edit the headers\nfor an Enter, Reply or Forward event')
  71. MsgFile = DataPath||EVENTTAGS.MSGFILE
  72. if pos('.',EVENTTAGS.CONFERENCE) > 0 then IsNews = 1
  73. else IsNews = 0
  74. ;;;
  75. /* ;;;Main loop */
  76. call ReadHeaders
  77. do until StopEdit = 1
  78.     StopEdit = MainMenu()
  79.     end
  80.  
  81. address(thorport)
  82. if Changed = 1 then REQUESTNOTIFY '"You have changed some headers.\nDo you want to save them before exiting?"' '"_Yes|_No"'
  83. if RC = 30 then call ExitMsg(THOR.LASTERROR)
  84. if result = 1 then call WriteHeaders
  85. ;;;
  86.  
  87. exit
  88.  
  89. /* ;;;Show messages to user */
  90. ShowMsg:
  91.     OldAddr = address()
  92.     address(thorport)
  93.     parse arg MsgStr
  94.     REQUESTNOTIFY '"'MsgStr'"' '" OK "'
  95.     address(OldAddr)
  96.     return
  97. ;;;
  98. /* ;;;Exit with a message */
  99. ExitMsg:
  100.     parse arg errmsg
  101.     call ShowMsg(errmsg)
  102.     exit
  103. ;;;
  104. /* ;;;Show main menu */
  105. MainMenu:
  106.     address(thorport)
  107.     do i = 1 to Menu.Count
  108.         interpret 'Header.'NowHeaders+i '=' Menu.i
  109.         end
  110.     Header.Count = NowHeaders + Menu.Count
  111.  
  112.     REQUESTLIST instem Header SIZEGADGET title '"Headers in current message"'
  113.     if RC = 30 then call ExitMsg(THOR.LASTERROR)
  114.     option = result
  115.     if RC = 5 then return 1
  116.     select
  117.         when option = '' then nop
  118.         when option = 'Add new header' then call AddHeader
  119.         when option = 'Save and exit' then do
  120.             call WriteHeaders
  121.             return 1
  122.             end
  123.         when option = 'HELP' then do
  124.             address command 'MultiView `GetEnv THOR/THORPath`docs/HeaderManager.guide PUBSCREEN' GLOBALCFG.PUBSCREENNAME
  125.             end
  126.         otherwise do
  127.             /* Get number of header selected */
  128.             HdrNo = 0
  129.             do i = 1 to NowHeaders
  130.                 if Header.i = option then HdrNo = i
  131.                 end
  132.  
  133.             REQUESTNOTIFY '"'option'\n\nEdit or Delete this header?"' '"_Edit|_Delete"'
  134.             if RC > 0 then ExitMsg(THOR.LASTERROR)
  135.             if result = 1 then call EditHeader
  136.             else call DeleteHeader
  137.             end
  138.         end
  139.     return 0
  140. ;;;
  141. /* ;;;Read headers in current event */
  142. ReadHeaders:
  143.     address(thorport)
  144.     if ~open(msg,MsgFile,'R') then call ExitMsg('Failed to open message file')
  145.     n = 0
  146.     drop Header.
  147.     Header.Count = 0
  148.     do until eof(msg)
  149.         NextLine = readln(msg)
  150.         if length(NextLine)=0 | right(word(NextLine,1),1) ~= ':' then leave
  151.         n = n + 1
  152.         Header.n = NextLine
  153.         Header.Count = n
  154.         end
  155.     call close(msg)
  156.     MsgHeaders = Header.Count
  157.     NowHeaders = Header.Count
  158.     return
  159. ;;;
  160. /* ;;;Update message file with new headers */
  161. WriteHeaders:
  162.     address(thorport)
  163.     OutFile = 'T:ThorHeaders.'time(s)
  164.     if ~open(msg,MsgFile,'R') then call ExitMsg('Failed to open message file')
  165.     if ~open(out,OutFile,'W') then call ExitMsg('Failed to open temporary file')
  166.     do i = 1 to MsgHeaders
  167.         call readln(msg)
  168.         end
  169.     do i = 1 to NowHeaders
  170.         call writeln(out,Header.i)
  171.         end
  172.     if MsgHeaders = 0 & NowHeaders > 0 then call writeln(out,'')
  173.     do until eof(msg)
  174.         block = readch(msg, 1048576)
  175.         call writech(out,block)
  176.         end
  177.     call close(out)
  178.     call close(msg)
  179.     address command 'copy' OutFile MsgFile
  180.     address command 'delete >NIL:' OutFile
  181.     Changed = 0
  182.     return
  183. ;;;
  184. /* ;;;Add a new header */
  185. AddHeader:
  186.     REQUESTLIST instem HdrMenu SIZEGADGET title '"Choose header to add"'
  187.     if RC = 30 then call ExitMsg(THOR.LASTERROR)
  188.     if RC = 5 then return
  189.     Hdr = result
  190.     select
  191.         when Hdr = 'Cc:' then do
  192.             if IsNews = 0 then call GetAddress
  193.             else do
  194.                 call ShowMsg('Cc: headers not allowed in news')
  195.                 Hdr = ''
  196.                 end
  197.             end
  198.         when Hdr = 'Bcc:' then do
  199.             Hdr = 'bcc:'
  200.             if IsNews = 0 then call GetAddress
  201.             else do
  202.                 call ShowMsg('Bcc: headers not allowed in news')
  203.                 Hdr = ''
  204.                 end
  205.             end
  206.         when Hdr = 'Followup-To:' then do
  207.             if IsNews = 1 then call GetConf
  208.             else do
  209.                 call ShowMsg('Followup-To: headers not allowed in mail')
  210.                 Hdr = ''
  211.                 end
  212.             end
  213.         when Hdr = 'Reply-To:' then do
  214.             call GetAddress
  215.             end
  216.         when Hdr = 'Custom' then do
  217.             REQUESTSTRING title '"Add header"' body '"Enter custom header"' bt '" OK |Cancel"' id '"X-"'
  218.             if RC = 0 then Hdr = result
  219.             else Hdr = ''
  220.             end
  221.         otherwise nop
  222.         end
  223.     if Hdr > '' then do
  224.         NowHeaders = NowHeaders + 1
  225.         Header.Count = NowHeaders
  226.         Header.NowHeaders = Hdr
  227.         Changed = 1
  228.         end
  229.     return
  230. ;;;
  231. /* ;;;Edit a header */
  232. EditHeader:
  233.     HdrType = upper(word(Header.HdrNo,1))
  234.     Hdr = ''
  235.     select
  236.         when HdrType = 'CC:' then do
  237.             Hdr = 'cc:'
  238.             call GetAddress(subword(Header.HdrNo,2))
  239.             end
  240.         when HdrType = 'BCC:' then do
  241.             Hdr = 'bcc:'
  242.             call GetAddress(subword(Header.HdrNo,2))
  243.             end
  244.         when HdrType = 'FOLLOWUP-TO:' then do
  245.             Hdr = 'Followup-To:'
  246.             call GetConf(subword(Header.HdrNo,2))
  247.             end
  248.         when HdrType = 'REPLY-TO:' then do
  249.             Hdr = 'Reply-To:'
  250.             call GetAddress(subword(Header.HdrNo,2))
  251.             end
  252.         otherwise do
  253.             REQUESTSTRING title '"Edit header"' body '"Editing 'Header.HdrNo'"' bt '" OK |Cancel"' id '"'Header.HdrNo'"'
  254.             if RC = 0 then Hdr = result
  255.             end
  256.         end
  257.  
  258.     if Hdr ~= '' then do
  259.         Header.HdrNo = Hdr
  260.         Changed = 1
  261.         end
  262.  
  263.     return
  264. ;;;
  265. /* ;;;Delete a header */
  266. DeleteHeader:
  267.     do i = HdrNo to NowHeaders-1
  268.         interpret 'Header.i = Header.'i+1
  269.         end
  270.     NowHeaders = NowHeaders - 1
  271.     Changed = 1
  272.     return
  273. ;;;
  274. /* ;;;Ask for an email address */
  275. GetAddress:
  276.     parse arg default
  277.     if default > '' then OldHdr = Hdr default                   /* Backup original header */
  278.     else OldHdr = ''
  279.  
  280.     REQUESTSTRING title '"Address header"' body '"Enter email address(es)"' bt '" _OK |_Cancel"' id '"'default'"' maxchars 200
  281.     if RC = 30 then ExitMsg(THOR.LASTERROR)
  282.     if RC = 5 then do                                           /* If nothing entered */
  283.         Hdr = OldHdr
  284.         return
  285.         end
  286.     UserName = result
  287.     UserAddr = ''
  288.     drop USERS. SUG.
  289.     address(bbsread)
  290.     SEARCHBRUSER bbsname '"'System'"' stem USERS search '"'UserName'"' name address alias suggestusersstem SUG
  291.     if RC = 30 then call ExitMsg(BBSREAD.LASTERROR)
  292.     Found = result
  293.     if Found > 0 then do                                        /* Match(es) found */
  294.         drop LIST.
  295.         drop USERTAGS.
  296.         LIST.COUNT = USERS.COUNT
  297.  
  298.         do i = 1 to USERS.COUNT                                 /* Build a list of user names */
  299.             LIST.i.USERNR = USERS.i.USERNR
  300.             READBRUSER bbsname '"'System'"' usernr USERS.i.USERNR tagsstem USERTAGS
  301.             if RC > 0 then call ExitMsg(BBSREAD.LASTERROR)
  302.             LIST.i = USERTAGS.NAME
  303.             if(symbol("USERTAGS.ADDRESS") = "VAR") then LIST.i.ADDRESS = USERTAGS.ADDRESS
  304.             end
  305.  
  306.         address(thorport)                                       /* Select a user */
  307.         drop UserName.
  308.         REQUESTLIST instem LIST outstem USERS title '"Select user:"' dragselect
  309.         if RC = 30 then call ExitMsg(THOR.LASTERROR)
  310.  
  311.         do j = 1 to USERS.COUNT
  312.             do i = 1 to LIST.COUNT                              /* Check for email addresses */
  313.                 if LIST.i = USERS.j then UserAddr = UserAddr','LIST.i.ADDRESS
  314.                 end
  315.             end
  316.  
  317.         end
  318.  
  319.     else do                                                     /* No exact match found */
  320.         if(symbol("SUG.COUNT") = "VAR") then do
  321.             address(thorport)
  322.             drop USERS. UserNum.
  323.             REQUESTLIST instem SUG outstem USERS title '"Select user:"' dragselect
  324.             if RC = 30 then call ExitMsg(THOR.LASTERROR)
  325.             if RC = 5 then do                                   /* If cancelled, use address as typed */
  326.                 Hdr = Hdr UserName
  327.                 return
  328.                 end
  329.             do j = 1 to USERS.COUNT
  330.                 do i = 1 to SUG.COUNT                           /* Get the user number */
  331.                     if SUG.i = USERS.j then UserNum.j = SUG.i.USERNR
  332.                     end
  333.                 end
  334.  
  335.             address(bbsread)                                    /* Get data on users selected */
  336.             do i = 1 to USERS.COUNT
  337.                 drop USERTAGS.
  338.                 READBRUSER bbsname '"'System'"' usernr UserNum.i tagsstem USERTAGS
  339.                 if RC > 0 then call ExitMsg(BBSREAD.LASTERROR)
  340.                 if(symbol("USERTAGS.ADDRESS") = "VAR") then UserAddr = UserAddr','USERTAGS.ADDRESS
  341.                 end
  342.             end
  343.  
  344.         else do                                                 /* No users found in search */
  345.             call ShowMsg('No matching users found')
  346.             UserAddr = ''
  347.             Hdr = OldHdr
  348.             end
  349.         end
  350.  
  351. if left(UserAddr,1) = ',' then UserAddr = substr(UserAddr,2)
  352. if UserAddr > '' then Hdr = Hdr UserAddr
  353. else Hdr = ''
  354. return
  355. ;;;
  356. /* ;;;Ask for a conference name */
  357. GetConf:
  358.     parse arg default
  359.     if default > '' then OldHdr = Hdr default                      /* Backup original header */
  360.     else OldHdr = ''
  361.  
  362.     address(bbsread)
  363.     drop CONFS. SELECTED.
  364.     GETCONFLIST bbsname '"'System'"' stem CONFS
  365.     if RC = 30 then call ExitMsg(BBSREAD.LASTERROR)
  366.     address(thorport)
  367.     REQUESTLIST instem CONFS outstem SELECTED title '"Select newsgroup(s)"' dragselect
  368.     select
  369.         when RC = 30 then call ExitMsg(THOR.LASTERROR)
  370.         when RC = 5 then Hdr = OldHdr
  371.         otherwise do
  372.             Conf = ''
  373.             do i = 1 to SELECTED.COUNT
  374.                 if upper(SELECTED.i) = 'EMAIL' then SELECTED.i = 'poster'
  375.                 Conf = Conf','SELECTED.i
  376.                 end
  377.             Hdr = Hdr substr(Conf,2)
  378.             end
  379.         end
  380.     return
  381. ;;;
  382.  
  383.